home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / barchart.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-24  |  25.7 KB  |  551 lines
  1. 4   REM  B A R   C H A R T   P R O G R A M
  2. 5   REM  Version 1.0         March 15, 1982
  3. 6   REM  Copyright 1982   IBM Corporation
  4. 10  DIM M#(72),M(72),T(39),A%(71),TITLE$(3),LABEL$(71),S(71),W(71),SV$(12)
  5. 20  LOCATE ,,0: YOPT=1: DEFINT I,J,K,L,O,X,Y
  6. 25  ZX$(1) = "A": ZX$(2) = "B": ZX$(3) = "C" : ZX$(4) = "D"
  7. 26  ZX$(5) = "E": ZX$(6) = "F": ZX$(7) = "G" : ZX$(8) = "H"
  8. 27  IP = 0
  9. 30  MSG$(1) =" BAR CHART -- MAIN MENU": MSG$(3) =" GRAPH OPTIONS MENU": MSG$(2)="SELECT TYPE OF CHART" : MSG$(9) ="* *  B A R   C H A R T  * *"
  10. 33  XMSG$(1) = "Current Data Values"
  11. 40  MSG$(4) =" M O N T H L Y   G R A P H": MSG$(5) =" Q U A R T E R L Y   G R A P H": MSG$(6)=" Y E A R L Y   G R A P H ": MSG$(7) = "D O - I T - Y O U R S E L F    G R A P H"
  12. 55  SEL$ = "Select an Option: "  :EMSG$(1) = "NOTE: Year must be between 1000 and 9999"
  13. 60  KEY OFF:FOR I=1 TO 10: KEY I,"": NEXT: ON KEY (9) GOSUB 740: KEY (9) ON
  14. 70  ON KEY (1) GOSUB 8000: REDO%=1: KEY (1) ON
  15. 80  ON KEY (3) GOSUB 9000
  16. 90  DEF SEG: POKE 106,0
  17. 100  ON ERROR GOTO 7000
  18. 190  REM ---------------------------------------------------------------------
  19. 195  REM            INTRO SCREEN 1
  20. 200  CLS: LOCATE 12,25: PRINT MSG$(9)
  21. 205   LOCATE 14,33: PRINT "VERSION 1.0
  22. 210  LOCATE 24,50: PRINT "Press space bar to continue."
  23. 220  K$=INKEY$: IF K$<>" " THEN 220
  24. 229  REM ---------------------------------------------------------------------
  25. 230  REM           INTRO SCREEN 2
  26. 233  CLS: LOCATE 2,25: PRINT MSG$(9)
  27. 235  LOCATE 5,15:PRINT "1. On screens where an asterisk appears in":LOCATE 7,18:PRINT "the top right hand corner, the current image":LOCATE 9,18:PRINT "will remain until the SPACE BAR is depressed."
  28. 240   LOCATE 12,15: PRINT "2. On all other screens, you will be prompted  ":LOCATE 14,18:PRINT "for INPUT.
  29. 242   LOCATE 17,15:PRINT "3. To use a FUNCTION KEY when input is expected,":LOCATE 19,18:PRINT "press the desired key followed by the Enter Key."
  30. 250  LOCATE 1,80:PRINT "*"
  31. 260  K$=INKEY$: IF K$<>" " THEN 260
  32. 269  REM ---------------------------------------------------------------------
  33. 270  REM           INTRO SCREEN 3
  34. 273  CLS: LOCATE 1,25: PRINT MSG$(9)
  35. 276  LOCATE 4,12: PRINT "4. The following FUNCTION KEYS may be used:": LOCATE 7,15: PRINT "F1 -- To return to the top of the nearest Screen or": LOCATE 9 ,21: PRINT  "to skip these introductory screens and proceed"
  36. 278  LOCATE 11,21: PRINT "directly to the Main Menu": LOCATE 14,15: PRINT "F3 -- To run the set of Sample Charts.  This option  ": LOCATE 16,21: PRINT "is available only at the beginning of the":LOCATE 18,21
  37. 280  PRINT"BAR CHART Program. (See next screen)":LOCATE 21,15: PRINT"F9 -- To EXIT The BAR CHART Program at any time.
  38. 290  LOCATE 1,80:PRINT "*"
  39. 300  K$=INKEY$: IF K$<>" " THEN 300
  40. 303  REM ---------------------------------------------------------------------
  41. 305  REM           INTRO SCREEN 4 -- SAMPLES INSTRUCTIONS
  42. 308  KEY (3) ON
  43. 310  CLS: LOCATE 2,28: PRINT "* *  B A R   C H A R T  * *
  44. 330  LOCATE 6,25:PRINT "A set of Sample Charts are included ":LOCATE  8,25:PRINT "with the BAR CHART Program."
  45. 340  LOCATE 11,25:PRINT "To run the Sample Demonstration  ":LOCATE 13,25:PRINT "Press the F3 Key now."
  46. 350  LOCATE 16,25:PRINT "Otherwise Push the Space BAR.  "
  47. 390  K$=INKEY$: IF K$ <> " " THEN 390: ELSE KEY (3) OFF
  48. 400  REM ---------------------------------------------------------------------
  49. 403  REM           START OF PROGRAM  -- MENU 1
  50. 406  REDO%=1: SAMPLE$="n":CLS:LOCATE 2,28:PRINT MSG$(1) :LOCATE 6,1:PRINT SEL$
  51. 410  LOCATE 11,28: PRINT "1. RETRIEVE DATA FILE":LOCATE 13,28:PRINT "2. CREATE NEW GRAPH":LOCATE 15,28:PRINT "3. ERASE DATA FILE"
  52. 420  LOCATE 17,28: IF OPT3=9  THEN PRINT "4. SELECT GRAPH OPTIONS
  53. 430  IF OP$="3" THEN  SV$="3": ELSE SV$=""
  54. 440  LOCATE 6,19: INPUT OP$
  55. 450  IF OP$="2" THEN 530
  56. 460  IF OP$="3" THEN 4300
  57. 470  IF OP$="4" THEN IF SV$<>"3"  AND OPT3<>9 THEN 440: ELSE 3800
  58. 480  IF OP$<>"1" THEN BEEP: GOTO 440
  59. 490  CLS: LOCATE 2, 25: PRINT " RETRIEVE A DATA FILE"
  60. 495  LOCATE 4: FILES "*.BAR"
  61. 497  LOCATE 22,5: PRINT "NOTE: Type / to Cancel Retrieve Option"
  62. 498  LOCATE 15,1: PRINT"Enter Name of File to be Retrieved"
  63. 500  LOCATE 15,36: INPUT FILE$: IF FILE$ ="/" THEN GOTO 406
  64. 505   FOR K=1 TO LEN(FILE$): IF MID$(FILE$,K,1)="." THEN 508: ELSE NEXT
  65. 508  IF MID$(FILE$,2,1) =":" THEN IF K>11 THEN K=11: GOTO 515
  66. 510  IF K>9 THEN K=9
  67. 515  LOCATE 18,1: PRINT "                         "
  68. 520  OLDFILE$=LEFT$(FILE$,K-1): OLDFILE$=OLDFILE$+".BAR"
  69. 522  GOSUB 4600: REM READ INPUT DATA FILE
  70. 525  REM
  71. 530  IF OP$="2" THEN OPT3=0 :GOSUB 800: REM SELECT GRAPH OPTION (MENU 2)
  72. 600  IF OPT=1 THEN GOSUB 900 : REM  MONTHLY GRAPH
  73. 610  IF OPT=2 THEN GOSUB 1100 :REM  QUARTERLY GRAPH
  74. 620  IF OPT=3 THEN GOSUB 1500 :REM  YEARLY GRAPH
  75. 630  IF OPT=4 THEN GOSUB 5000 :REM  DO IT YOURSELF GRAPH
  76. 640  GOSUB 1300: REM INPUT GRAPH DATA
  77. 650  GOSUB 1700: REM INPUT GRAPH TITLES
  78. 660  GOSUB 1800: REM CALCULATE GRAPH SCALE
  79. 670  GOSUB 2400: REM DISPLAY THE GRAPH
  80. 680  IF OPT=1 THEN GOSUB 2800: REM LABEL LINE -- MONTHLY
  81. 690  IF OPT=2 THEN GOSUB 3000: REM LABEL LINE -- QUARTERLY
  82. 700  IF OPT=3 THEN GOSUB 2900: REM LABEL LINE -- YEARLY
  83. 710  IF OPT=4 THEN GOSUB 3200: REM LABEL LINE -- DO IT YOURSELF
  84. 720  GOSUB 3300
  85. 730  GOTO 3800
  86. 740  CLS: KEY 2,"run"+CHR$(13): END
  87. 800  REM ---------------------------------------------------------------------
  88. 802  REM               MENU 2 -- SELECT TYPE OF GRAPH
  89. 805  REDO%=2:CLS:LOCATE 2,28:PRINT  MSG$(2):LOCATE 6,1:PRINT SEL$:LOCATE 9,28:PRINT "1. MONTHLY   (12 Month Period)":LOCATE 11,28:PRINT "2. QUARTERLY (1 -3 Years)":LOCATE 13,28:PRINT "3. YEARLY    (2 - 20 Years)":LOCATE 15,28
  90. 808  LOCATE 15,28:PRINT "4. DO-IT-YOURSELF GRAPH":LOCATE 16,31 : PRINT "(Define your own Labels and Bar Spacing)
  91. 810  LOCATE 6,20:INPUT Z$ :IF VAL(Z$)<1 OR VAL(Z$)>4 THEN BEEP: GOTO 810: ELSE OPT=VAL(Z$)\1
  92. 815  QOPT$="":YRS=0
  93. 820  RETURN
  94. 900  REM ---------------------------------------------------------------
  95. 902  REM                  MONTHLY
  96. 910  REDO%=3: CLS : LOCATE 1,28:PRINT MSG$(4)
  97. 920  LOCATE 6,1:PRINT "Enter the last Month and Year for which data will be entered."
  98. 925  LOCATE 8,10:PRINT "Month  (MM) ":LOCATE 8,50: INPUT Z1$: IF VAL(Z1$) <1 OR VAL (Z1$) > 12 THEN BEEP: GOTO 925: ELSE MTH% = VAL(Z1$)\1
  99. 930  LOCATE 10,10:PRINT "Year  (YYYY) ":LOCATE 10,50: INPUT Z2$
  100. 940  IF VAL(Z2$)<1000 OR VAL(Z2$)>9999 THEN LOCATE 14,1: PRINT EMSG$(1): BEEP: GOTO 930: ELSE YR=VAL(Z2$)\1
  101. 950  N=11:XL=59:W=3:S=2
  102. 960  LABEL$(0)="JAN":LABEL$(1)="FEB":LABEL$(2)="MAR":LABEL$(3)="APR":LABEL$(4)="MAY":LABEL$(5)="JUN":LABEL$(6)="JUL":LABEL$(7)="AUG":LABEL$(8)="SEP":LABEL$(9)="OCT":LABEL$(10)="NOV":LABEL$(11)="DEC"
  103. 970  FOR I=0 TO 11-MTH%: SV$(I)=LABEL$(I+MTH%):NEXT
  104. 980  FOR I=12-MTH% TO 11:SV$(I)=LABEL$(I-12+MTH%):NEXT
  105. 990  FOR I=0 TO 11:LABEL$(I)=SV$(I):NEXT: IF OP$="1" THEN RETURN
  106. 1000  REDO%=4: CLS : LOCATE 1,28:PRINT MSG$(4)
  107. 1005  LOCATE 4,1:IF OPT4 <> 2 THEN PRINT "Enter a Value for each Month":ELSE PRINT XMSG$(1)
  108. 1010  FOR I=0 TO 11: LOCATE I+6,1: PRINT LABEL$(I);",";:IF I<12-MTH% THEN PRINT YR-1:ELSE PRINT YR
  109. 1020  NEXT: IF OPT3=3 THEN 1300: REM OPT3 -- DISPLAY DATA
  110. 1030  RETURN 640
  111. 1100  REM --------------------------------------------------------------
  112. 1102  REM                  QUARTERLY
  113. 1103  REDO%=5: CLS : LOCATE 1,23:PRINT MSG$(5)
  114. 1105  LOCATE 4,1:PRINT "The Quarterly Graph will display Quarterly Data for 1 to 3 Years":LOCATE 6,5:PRINT "If more than 1 Year is selected, the data can be plotted ":LOCATE 7,5:PRINT "Chronologically or Grouped by Quarters."
  115. 1110  LOCATE 10,1:PRINT "Number of Years for which data will be entered."
  116. 1120  LOCATE 10,61:INPUT Z$ :IF VAL(Z$)<1 OR VAL(Z$)>3 THEN BEEP: GOTO 1120: ELSE YRS=VAL(Z$)\1
  117. 1130  IF YRS=1 THEN Z$="":QOPT$="c":GOTO 1160:ELSE Z$="Last"
  118. 1140  LOCATE 13,1:PRINT "Select type of display": LOCATE 14,5 :PRINT " Chronological (C) or Grouped by Quarters (G)"
  119. 1150  LOCATE 13,61:INPUT QOPT$:IF QOPT$ ="C" THEN QOPT$ ="c"
  120. 1153  IF QOPT$ ="G" THEN QOPT$ = "g"
  121. 1155  IF QOPT$<>"c" AND QOPT$<>"g" THEN BEEP: GOTO 1150
  122. 1160  IF YRS=1 THEN X=13: ELSE X=17
  123. 1170  LOCATE X,1:PRINT Z$;" Year for which data will be entered.":
  124. 1180  LOCATE X,61: INPUT Z$: IF VAL(Z$)<1000 OR VAL(Z$)>9999 THEN BEEP: LOCATE X+4,1:PRINT EMSG$(1):GOTO 1180:ELSE YR=VAL(Z$)\1
  125. 1190  REDO%=6: CLS : LOCATE 1,23:PRINT MSG$(5)
  126. 1195  LOCATE 4,1:IF OPT4 <> 2 THEN PRINT "Enter a Value for each Quarter" :ELSE PRINT XMSG$(1)
  127. 1200  K=-1:FOR I=1 TO YRS:FOR J=1 TO 4: K=K+1:LOCATE 6+K,1:PRINT USING "####"; YR+I-YRS;:PRINT " QTR";J:NEXT:NEXT:IF OPT3=3 THEN GOTO 1300
  128. 1210  N=YRS*4-1:IF QOPT$="c" THEN 1230
  129. 1220  IF YRS=2 THEN XL=63:S=10:W=6:GOTO 1250:ELSE XL=63:S=12:W=4:GOTO 1250
  130. 1230  IF YRS=1 THEN XL=61:S=4:W=12:GOTO 1250
  131. 1240  IF YRS=2 THEN XL=64:S=2:W=6:ELSE XL=60:S=1:W=4
  132. 1250  IF OP$="2" THEN RETURN 640: ELSE RETURN
  133. 1300  REM --------------------------------------------------------------
  134. 1303  REM               INPUT GRAPH DATA
  135. 1306  I=-1:J=0
  136. 1310  I=I+1: K=I: L=17
  137. 1320  IF N>11 THEN K=I MOD (N+2)\2: IF I>=(N+1)/2 THEN L=57
  138. 1330  LOCATE 6+K,L,1: IF OPT4<>2 THEN INPUT Z$: M#(I)=VAL(Z$): ELSE PRINT M#(I): GOTO 1380
  139. 1340  IF ABS(M#(I))<1E+15 THEN 1380
  140. 1350  J=1
  141. 1360  BEEP: LOCATE 22,1:PRINT "Enter numbers no greater in absolute value "
  142. 1370  LOCATE 23,1:PRINT "than 999,999,999,999,999. Do not use commas.":IF J=2 THEN 1450:ELSE 1330
  143. 1380  IF I<N THEN 1310
  144. 1390  IF OPT4=2 THEN RETURN
  145. 1400  IF J=1 THEN LOCATE 22,1: FOR X=1 TO 2: FOR Y=1 TO 10: PRINT "          ";:NEXT:NEXT
  146. 1410  LOCATE K+9,1: GOSUB 5900: REM RELATIVE TO AVERAGE (Y OR N)
  147. 1420  IF R$="y" THEN 1460
  148. 1430  IF R$="n" THEN LOCATE K+9,1:FOR X=1 TO 5: PRINT "               ";:NEXT:ELSE BEEP: GOTO 1410
  149. 1440  LOCATE K+9,1:PRINT "Enter the value of the horizontal axis."
  150. 1450  LOCATE K+9,50: INPUT Z$: REF#=VAL(Z$): IF REF#>1E+15 THEN J=2: GOTO 1360
  151. 1460  RETURN
  152. 1500  REM --------------------------------------------------------------
  153. 1502  REM                 YEARLY
  154. 1503  REDO%=7: CLS : LOCATE 1,26:PRINT MSG$(6)
  155. 1505   LOCATE 6,1:PRINT "Enter the Number of Years to be Graphed": LOCATE 7,5: PRINT "(Minimum is 2, Maximum is 20)"
  156. 1510  LOCATE 6,61: INPUT Z$: IF VAL(Z$)<2 OR VAL(Z$)>20 THEN BEEP: GOTO 1510:ELSE N=VAL(Z$)\1-1
  157. 1515   LOCATE 9,1:PRINT "Last Year for which Data will be Entered."
  158. 1520  LOCATE 9,61: INPUT Z$: IF VAL(Z$)>999 AND VAL(Z$)<10000 THEN YR=VAL(Z$):GOTO 1540
  159. 1530  LOCATE 13,1: PRINT EMSG$(1): BEEP:GOTO 1520
  160. 1540  REDO%=8: CLS : LOCATE 1,26:PRINT MSG$(6)
  161. 1545  LOCATE 4,1:IF OPT4 <> 2 THEN PRINT "Enter a Value for each Year": ELSE PRINT XMSG$(1)
  162. 1550  I=-1
  163. 1560  I=I+1: K=I: L=5
  164. 1570  IF N>11 THEN K=I MOD (N+2)\2: IF I>=(N+1)/2 THEN L=40
  165. 1580  LOCATE 6+K,L:PRINT USING "####"; YR+I-N:IF I<N THEN 1560
  166. 1590  IF OPT3=3 THEN 1300
  167. 1600  IF N>=16 THEN S=1:GOTO 1670
  168. 1610  IF 9<=N AND N<=15 THEN S=2
  169. 1620  IF N=12 OR N=11 THEN S=1: GOTO 1670
  170. 1630  IF N=7 THEN S=2:GOTO 1670
  171. 1640  IF 4<=N AND N<=6 THEN S=3:GOTO 1670
  172. 1650  IF N=8 THEN S=3:GOTO 1670
  173. 1660  IF 1<=N AND N<=3 THEN S=5:GOTO 1670
  174. 1670  W=S-1
  175. 1680  W=W+1: XL=1+(N+1)*W+S*N: IF XL+N+1<67 THEN 1680
  176. 1690  IF OP$="2" THEN RETURN 640: ELSE RETURN
  177. 1700  REM --------------------------------------------------------------
  178. 1705  REDO%=9: CLS: LOCATE 1,28:PRINT"G R A P H   T I T L E S
  179. 1710  LOCATE 6,1:PRINT "Enter the Title of the Graph"
  180. 1715  LOCATE 22,5: PRINT"NOTE: Titles may not contain commas (,)
  181. 1720  LOCATE 7,5:PRINT "(maximum two lines of 80 characters)"
  182. 1740  LOCATE 9,1,1:INPUT TITLE$(1)
  183. 1750  LOCATE 10,1,1:INPUT TITLE$(2)
  184. 1755  LOCATE 13,1:PRINT "Enter the Title of the Vertical Axis"
  185. 1760  LOCATE 15,1,1:INPUT TITLE$(3)
  186. 1770  IF OPT3=7 THEN 3800
  187. 1780  RETURN
  188. 1800  REM --------------------------------------------------------------
  189. 1803  REM               CALCULATE GRAPH SCALE
  190. 1805  CLS: LOCATE 25,62: PRINT "Just a second...."
  191. 1810  I=-1:AVG#=0: MIN#=ABS(M#(0)): MAX#=ABS(M#(0))
  192. 1820  I=I+1:IF M#(I)>MAX# THEN MAX#=M#(I)
  193. 1830  IF M#(I)<MIN# THEN MIN#=M#(I)
  194. 1850  IF I<N THEN 1820
  195. 1854  ASUM# =0: FOR I = 0 TO N: ASUM# = M#(I) + ASUM#: NEXT I: AVG# =ASUM#/(N+1)
  196. 1860  IF YOPT<>3 THEN 1900 :ELSE IF MIN#<0 OR AVG#=0 THEN PRCENT$="n": GOTO 4100:ELSE PRCENT$="y":SCALE$="":FOR K=0 TO N: M(K)=100*M#(K)/(AVG#*(N+1)):NEXT: MAX=100*MAX#/(AVG#*(N+1)): MIN=100*MIN#/(AVG#*(N+1))
  197. 1870  IF R$="n" THEN IF REF#>100 THEN REF=100: ELSE IF REF#<0 THEN REF=0: ELSE REF=REF#
  198. 1880  IF R$="y" THEN REF=100/(N+1)
  199. 1890  GOTO 2070
  200. 1900  IF R$="y" THEN REF#=AVG#
  201. 1910  ABMAX#=ABS(MAX#): IF ABS(MIN#)>ABMAX# THEN ABMAX#=ABS(MIN#)
  202. 1920  IF ABS(REF#)>ABMAX# THEN ABMAX#=ABS(REF#)
  203. 1930  IF ABMAX#>=0.000999999 AND ABMAX#<1000 THEN 1980
  204. 1940  IF ABMAX#>=1E+06 AND ABMAX# <1E+09 THEN 1990
  205. 1950  IF ABMAX#>=1000 AND ABMAX#<1E+06 THEN 2010
  206. 1960  IF ABMAX#>=1E+09 AND ABMAX#<1E+12 THEN 2030
  207. 1970  IF ABMAX#>=1E+12 THEN 2050
  208. 1980  AVG=AVG#:REF=REF#:MIN=MIN#:MAX=MAX#:FOR I=0 TO N: M(I)=M#(I):NEXT:SCALE$="":GOTO 2070
  209. 1990  AVG=AVG#/1E+06:REF=REF#/1E+06:MIN=MIN#/1E+06:MAX=MAX#/1E+06:FOR I=0 TO N:M(I)=M#(I)/1E+06: NEXT
  210. 2000  SCALE$="(in millions)": GOTO 2070
  211. 2010  AVG=AVG#/1000:REF=REF#/1000:MIN=MIN#/1000:MAX=MAX#/1000:FOR I=0 TO N:M(I)=M#(I)/1000: NEXT
  212. 2020  SCALE$="(in thousands)": GOTO 2070
  213. 2030  AVG=AVG#/1E+09:REF=REF#/1E+09:MIN=MIN#/1E+09:MAX=MAX#/1E+09: FOR I=0 TO N: M(I)=M#(I)/1E+09: NEXT
  214. 2040  SCALE$="(in billions)": GOTO 2070
  215. 2050  AVG=AVG#/1E+12:REF=REF#/1E+12:MIN=MIN#/1E+12:MAX=MAX#/1E+12: FOR I=0 TO N: M(I)=M#(I)/1E+12: NEXT
  216. 2060  SCALE$="(in trillions)": GOTO 2070
  217. 2070  IF YOPT<>2 THEN REF=CINT(REF)
  218. 2080  I=0: IF REF=<MIN THEN I=1: JUMP!=(MAX-REF)/37: GOTO 2150
  219. 2090  I=0: IF REF=<MIN THEN I=1: JUMP!=(MAX-REF)/37: GOTO 2150
  220. 2100  IF REF>=MAX THEN I=37: JUMP!=(REF-MIN)/37: GOTO 2150
  221. 2110  I=I+2: A=MIN+((MAX-MIN)/38)*(I-2): B=MIN+((MAX-MIN)/38)*I
  222. 2120  IF A<=REF AND REF<=B THEN I=I-1: GOTO 2130: ELSE 2110
  223. 2130  A=(MAX-REF)/(38-I): B=(REF-MIN)/I
  224. 2140  IF A>=B THEN JUMP!=A:ELSE JUMP!=B
  225. 2150  IF YOPT=2 THEN 2180:ELSE  IF JUMP!<0.25 THEN JUMP!=0.25
  226. 2155  SV=JUMP!: J!=INT(JUMP!)-0.25
  227. 2160  J!=J!+0.25: IF SV>J!+0.05 THEN JUMP!=J!+0.25: IF J!<INT(SV)+1 THEN 2160
  228. 2180  IF YOPT=2 THEN IF JUMP!=0 THEN JUMP!=0.000999999
  229. 2190  T(I)=REF: FOR J=0 TO 38: T(J)=T(I)+(J-I)*JUMP!:NEXT
  230. 2200  XAXIS=23.5-I/2: XTIC=I
  231. 2210  I=-1
  232. 2220  I=I+1: A%(I)=0
  233. 2230  J=0:IF M(I)>=0.5*(T(32)+T(31)) THEN J=31: GOTO 2270
  234. 2240  IF M(I)>=0.5*(T(24)+T(23)) THEN J=23: GOTO 2270
  235. 2250  IF M(I)>=0.5*(T(16)+T(15)) THEN J=15: GOTO 2270
  236. 2260  IF M(I)>=0.5*(T(8)+T(7)) THEN J=7
  237. 2270  J=J+1: IF M(I)>=0.5*(T(J)+T(J-1)) THEN A%(I)=J: ELSE 2290
  238. 2280  IF J<38 THEN 2270
  239. 2290  IF I<N THEN 2220
  240. 2300  RETURN
  241. 2400  REM ----------------------------------------------------------
  242. 2403  REM               DISPLAY THE GRAPH
  243. 2405  YAX=(82-XL-1)\2: IF YAX<8 THEN YAXSV=YAX: YAX=8: ELSE YAXSV=8
  244. 2410  IF OPT3=2 THEN LPRINT CHR$(27)+CHR$(12)
  245. 2420  CLS: IF GRID$<>"y" THEN 2450
  246. 2430  DOT$="": FOR I=1 TO XL: DOT$=DOT$+CHR$(249): NEXT:
  247. 2440  FOR I=5 TO 23: LOCATE I,YAX+1: PRINT DOT$;: NEXT
  248. 2450  I=4: IF 1=XAXIS MOD 2 THEN I=3
  249. 2460  I=I+2:J=39-2*(I-4): IF T(J)>=0 THEN 2510
  250. 2470  LOCATE I,YAX-7:IF T(J)<=-1000 OR YOPT<>2 THEN PRINT USING "+####.";T(J): LOCATE I,YAX-2: IF YOPT<>3 THEN PRINT ".";:GOTO 2550: ELSE PRINT "%";: GOTO 2550
  251. 2480  IF T(J)<=-100 AND T(J)>-1000 THEN PRINT USING "+###.#";T(J):GOTO 2550
  252. 2490  IF T(J)>-100 AND T(J)<=-10 THEN PRINT USING "+##.##";T(J):GOTO 2550
  253. 2500  PRINT USING "+#.###";T(J):GOTO 2550
  254. 2510  LOCATE I,YAX-6:IF T(J)>=1000 OR YOPT<>2 THEN PRINT USING "####.";T(J): LOCATE I,YAX-2: IF YOPT<>3 THEN PRINT ".";:GOTO 2550: ELSE PRINT "%";: GOTO 2550
  255. 2520  IF T(J)>=100 AND T(J)<1000 THEN PRINT USING "###.#";T(J):GOTO 2550
  256. 2530  IF T(J)<100 AND T(J)>=10 THEN PRINT USING "##.##";T(J):GOTO 2550
  257. 2540  PRINT USING "#.###";T(J)
  258. 2550  IF I<22 THEN 2460
  259. 2560  K=0
  260. 2570  K=K+1
  261. 2580  I=LEN(TITLE$(K)): J=(82-I)\2: IF YAXSV<8 THEN J=J+YAXSV\2
  262. 2590  IF J<1 THEN J=1
  263. 2600  LOCATE K,J:PRINT TITLE$(K)
  264. 2610  IF K=1 GOTO 2570
  265. 2620  I=LEN(TITLE$(3)):J=(2*YAX+1-I)\2:IF J<1 THEN J=1
  266. 2630  IF SCALE$="" THEN 2650
  267. 2640  LOCATE 3,J:PRINT TITLE$(3):LOCATE 4,YAX-6:PRINT SCALE$:GOTO 2660
  268. 2650  LOCATE 4,J:PRINT TITLE$(3)
  269. 2660  FOR J=YAX TO XL+YAX:LOCATE XAXIS,J
  270. 2670  PRINT CHR$(196);:NEXT
  271. 2680  FOR I=5 TO 23:LOCATE I,YAX
  272. 2690  PRINT CHR$(197):NEXT
  273. 2700  IF XTIC=1 THEN LOCATE 23,YAX:PRINT CHR$(192)
  274. 2710  IF XTIC=37 THEN LOCATE 5,YAX: PRINT CHR$(218)
  275. 2720  RETURN
  276. 2800  REM --------------------------------------------------------------
  277. 2803  REM              LABEL LINE -- MONTHLY
  278. 2805  LOCATE 24,YAX+1:FOR I=0 TO 11:PRINT LABEL$(I)+"  ";:NEXT:LOCATE 24,XL+YAX+2:IF MTH%=12 THEN PRINT YR;:ELSE PRINT " "+RIGHT$(STR$(YR-1),2);"-";RIGHT$(STR$(YR),2);
  279. 2810  RETURN 720
  280. 2900  REM --------------------------------------------------------------
  281. 2903  REM              LABEL LINE -- YEARLY
  282. 2905  IF W>4 THEN W1=(W-4)\2: ELSE W1=0
  283. 2910  FOR I=0 TO N :J=YAX+W1+(W+S)*I+1: LOCATE 24,J: IF N>13 THEN PRINT RIGHT$(STR$(YR+I-N),2);: ELSE PRINT RIGHT$(STR$(YR+I-N),4);
  284. 2920  NEXT: RETURN 720
  285. 3000  REM --------------------------------------------------------------
  286. 3003  REM              LABEL LINE -- QUARTERLY
  287. 3005  IF QOPT$="g" THEN 3060
  288. 3010  IF YRS<>1 THEN 3030
  289. 3020  FOR I=1 TO 4: J=YAX+1+16*(I-1): LOCATE 24,J+7:PRINT RIGHT$(STR$(YR),4);:LOCATE 24,J+1:PRINT "QTR";:LOCATE 24,J+4: PRINT I;:LOCATE 24,J+6: PRINT ",";:NEXT:GOTO 3110
  290. 3030  IF YRS<>2 THEN 3050
  291. 3040  K=-1: FOR I=0 TO 1: FOR J=1 TO 4: K=K+1: L=YAX+8*K:LOCATE 24,L+5: PRINT RIGHT$(STR$(YR-1+I),2);:LOCATE 24,L:PRINT J;:LOCATE 24,L+2: PRINT "QTR";:NEXT:NEXT: GOTO 3110
  292. 3050  K=-1: FOR I=0 TO 2: FOR J=1 TO 4: K=K+1: L=YAX+5*K:LOCATE 24,L+3: PRINT RIGHT$(STR$(YR-2+I),2);: LOCATE 24,L:PRINT J;:LOCATE 24,L+2:PRINT "Q";:NEXT:NEXT: GOTO 3110
  293. 3060  IF YRS<>2 THEN 3090
  294. 3070  FOR I=0 TO 1:FOR J=1 TO 4
  295. 3080  L=(YAX+7*I)+16*(J-1):LOCATE 24,L+5:PRINT RIGHT$(STR$(YR-1+I),2);:LOCATE 24,L:PRINT J;:LOCATE 24,L+2:PRINT "QTR";:NEXT:NEXT:GOTO 3110
  296. 3090  FOR I=0 TO 2:FOR J=1 TO 4:L=(YAX+5*I)+16*(J-1)
  297. 3100  LOCATE 24,L+3:PRINT RIGHT$(STR$(YR-2+I),2);: LOCATE 24,L:PRINT J;:LOCATE 24,L+2:PRINT "Q";:NEXT:NEXT
  298. 3110  RETURN 720
  299. 3200  REM --------------------------------------------------------------
  300. 3203  REM              LABEL LINE -- DO IT YOURSELF
  301. 3205  X=YAX+1: FOR J=0 TO N: X=X+S(J)+W(J): Y=X+(W(J+1)-LEN(LABEL$(J)))\2
  302. 3210  LOCATE 24,Y: PRINT LABEL$(J);:NEXT: RETURN
  303. 3300  REM --------------------------------------------------------------
  304. 3303  REM
  305. 3305  L=0: X9=YAX+1: IF QOPT$="g" THEN N=3
  306. 3310  L=L+1:IF YRS=2 THEN X9=YAX+1+(L-1)*7
  307. 3320  IF YRS=3 THEN X9=YAX+1+(L-1)*5
  308. 3330  IF OPT=4 AND DOOP$="2" THEN Y=YAX+1+S(0)
  309. 3340  I=-1
  310. 3350  I=I+1:P%=I+(L-1)*4
  311. 3360  IF OPT=4 AND DOOP$="2" THEN W=W(I+1): IF I>0 THEN Y=Y+S(I)+W(I)
  312. 3370  IF A%(P%)=XTIC THEN 3660
  313. 3380  IF XTIC=1 AND A%(P%)=0 THEN 3660
  314. 3390  IF XTIC=37 AND A%(P%)=38 THEN 3660
  315. 3400  IF OPT=4 AND DOOP$="1" THEN S=S(1):W=W(1)
  316. 3410  IF OPT<>4 OR DOOP$<>"2" THEN  Y=X9+(W+S)*I
  317. 3420  IF XTIC>A%(P%) THEN 3550
  318. 3430  IF 1=A%(P%) MOD 2 THEN 3500
  319. 3440  X=(40-A%(P%))/2+4
  320. 3450  FOR J=Y TO Y+W-1
  321. 3460  LOCATE XAXIS,J: PRINT CHR$(223)
  322. 3470  FOR K=X TO XAXIS-1: LOCATE K,J:PRINT CHR$(219)
  323. 3480  NEXT:NEXT
  324. 3490  GOTO 3660
  325. 3500  X=(39-A%(P%))/2+4
  326. 3510  FOR J=Y TO Y+W-1
  327. 3520  LOCATE XAXIS,J: PRINT CHR$(223): LOCATE X,J: PRINT CHR$(220)
  328. 3530  FOR K=X+1 TO XAXIS-1: LOCATE K,J: PRINT CHR$(219):NEXT:NEXT
  329. 3540  GOTO 3660
  330. 3550  IF 1=A%(P%) MOD 2 THEN 3620
  331. 3560  X=(38-A%(P%))/2+4
  332. 3570  FOR J=Y TO Y+W-1
  333. 3580  LOCATE XAXIS,J: PRINT CHR$(220)
  334. 3590  FOR K=XAXIS+1 TO X: LOCATE K,J:PRINT CHR$(219)
  335. 3600  NEXT:NEXT
  336. 3610  GOTO 3660
  337. 3620  X=(39-A%(P%))/2+4
  338. 3630  FOR J=Y TO Y+W-1
  339. 3640  LOCATE XAXIS,J: PRINT CHR$(220): LOCATE X,J: PRINT CHR$(223)
  340. 3650  FOR K=XAXIS+1 TO X-1: LOCATE K,J: PRINT CHR$(219):NEXT:NEXT
  341. 3660  '
  342. 3670  IF I<N THEN 3350
  343. 3680  IF QOPT$="g" AND L<YRS THEN 3310:ELSE IF QOPT$="g" THEN N=YRS*4-1
  344. 3690  IF OPT3=2 THEN GOSUB 4800
  345. 3700  LOCATE 1,80: PRINT "*";
  346. 3710  L$=INKEY$: IF L$<>" " THEN 3710
  347. 3720  IF SAMPLE$="y" THEN GOTO 9010
  348. 3730  RETURN
  349. 3800  REM --------------------------------------------------------------
  350. 3802  REM                  MENU 3 OPTIONS
  351. 3805  REDO%=10:CLS: OPTF$="0": G$ ="n":LOCATE 2,28: PRINT MSG$(3):LOCATE 6,1: PRINT SEL$
  352. 3810  LOCATE 8,11:PRINT "1. DISPLAY GRAPH": LOCATE 10,11:PRINT "2. PRINT GRAPH":LOCATE 10,43: PRINT "6. CHANGE HORIZONTAL AXIS":LOCATE 12,11:PRINT "3. DISPLAY DATA":LOCATE 12,43: PRINT "7. CHANGE TITLES":LOCATE 14,11: PRINT "4. SAVE DATA FILE"
  353. 3813  LOCATE 14,43:PRINT "8. Y-AXIS OPTIONS": LOCATE 16,28:PRINT "9. RETURN TO MAIN MENU"
  354. 3815  LOCATE 8,43: IF GRID$ <> "y" THEN PRINT "5. ADD GRID LINES": ELSE PRINT "5. DELETE GRID LINES"
  355. 3820  LOCATE 6,20: INPUT Z$: IF VAL(Z$)<1 OR VAL(Z$)>9 THEN BEEP: GOTO 3820: ELSE OPT3=VAL(Z$)\1
  356. 3825  IF OPT3 = 3 THEN OPT4 = 2: ELSE OPT4 =0
  357. 3830  ON OPT3 GOTO 670,670,5500,3840,4060,3950,1700,4100,400
  358. 3835  REM                  SAVE THE FILE
  359. 3840  LOCATE 22,1: PRINT "Enter the name under which the file shall be saved."
  360. 3850  LOCATE 22,55:INPUT DATUM$: FOR K=1 TO LEN(DATUM$):IF MID$(DATUM$,K,1)="." THEN 3854: ELSE NEXT
  361. 3854  IF MID$(DATUM$,2,1)=":" THEN IF K>11 THEN K = 11: GOTO 3870
  362. 3860  IF K>9 THEN K=9
  363. 3870  DATUM$=LEFT$(DATUM$,K-1): NEWFILE$=DATUM$+".BAR"
  364. 3875  GOSUB 4200: REM WRITE .BAR FILE
  365. 3878  GOSUB 5700: REM CLEAR 19 LINES
  366. 3880   LOCATE 22,1:PRINT "File ";DATUM$;" has been Saved.": LOCATE 6,20: PRINT "    ": GOTO 3820
  367. 3900  REM --------------HORIZONTAL AXIS---------------------------------
  368. 3950  GOSUB 4050 : REM CLEAR LINE 23
  369. 3960  IF R$="y" THEN R$="n": GOTO 4010
  370. 3970  LOCATE 23,1: GOSUB 5900 : REM REL/AVG MSG
  371. 3980  IF R$="y" THEN 4030
  372. 3990  IF R$<>"n" THEN BEEP: GOTO 3970
  373. 4000  GOSUB 4050 : REM CLEAR LINE 23
  374. 4010  LOCATE 23,1:PRINT "Enter the Value of the Horizontal Axis.";
  375. 4020  LOCATE 23,50:INPUT Z$: REF#=VAL(Z$) :IF REF#>=1E+16 THEN BEEP: GOTO 4020
  376. 4030  GOSUB 1860: GOSUB 4050: REM GRAPH SCALE, CLEAR LINE 23
  377. 4040  LOCATE 6,21:PRINT "  ";: GOTO 3805
  378. 4045  REM --------------------------------------------------------------------
  379. 4050  LOCATE 23,1:FOR J=1 TO 19:PRINT "    ";:NEXT: RETURN: REM CLEAR LINE 23
  380. 4055  REM ----------------CHANGE GRID ON/OFF----------------------------------
  381. 4060  IF G$="n" THEN IF GRID$<>"y" THEN GRID$="y":ELSE GRID$="n"
  382. 4070  G$="y": GOTO 4040
  383. 4100  REM --------------------------------------------------------------
  384. 4105  REDO%=14: CLS: SV=YOPT: LOCATE 2,23:PRINT "SELECT Y-AXIS OPTION":LOCATE 10,1:PRINT SEL$:LOCATE 5,1:PRINT "This option determines how the Y-Axis Tick Values are calculated.":LOCATE 7,5: PRINT "The current Y-Axis option is ";YOPT
  385. 4110  LOCATE 13,23:PRINT "1. INTEGERS (rounding occurs)":LOCATE 15,23:PRINT "2. EXACT (to four digits)":LOCATE 17,23:PRINT "3. PERCENTAGES (rounded to integers)":GOSUB 5800
  386. 4120  LOCATE 10,20:INPUT Z$: IF VAL(Z$)<1 OR VAL(Z$)>3 THEN BEEP: GOTO 4120: ELSE YOPT=VAL(Z$)
  387. 4130  GOSUB 5800: IF PRCENT$="n" AND YOPT=3 THEN 4120:ELSE IF SV=YOPT THEN 3800: ELSE GOSUB 1810: GOTO 3800
  388. 4190  REM ---------------------------------------------------------------------
  389. 4195  REM                   WRITE .BAR FILE
  390. 4200  OPEN NEWFILE$ FOR OUTPUT AS #1:KEY (1) STOP: KEY (9) STOP
  391. 4210  PRINT#1,N,MTH%,YR,YRS,OPT,REF#,YOPT,DUMMY1,DUMMY2,
  392. 4220  FOR I=0 TO N: PRINT#1,M#(I),:NEXT
  393. 4230  IF OPT<>4 THEN 4250
  394. 4240  FOR I=0 TO N: PRINT#1,S(I),W(I+1):NEXT
  395. 4250  PRINT#1,TITLE$(1);",";TITLE$(2);",";TITLE$(3);",";QOPT$;",";R$;",";DOOP$;",";GRID$;",";DUMMY1$;",";DUMMY2$
  396. 4260  IF OPT<>4 THEN 4280
  397. 4270  FOR I=0 TO N: PRINT#1,LABEL$(I);",";:NEXT
  398. 4280  CLOSE #1: KEY (9) ON: KEY (1) ON: RETURN
  399. 4300  REM ---------------------------------------------------------------------
  400. 4303  REM             SELECT FILE OPTION (ERASE OR RETURN)
  401. 4305  REDO%=12: CLS: LOCATE 2,25:PRINT "BAR CHART  -- DATA FILES"
  402. 4310  LOCATE 4: FILES "*.BAR"
  403. 4318  LOCATE 14,1:PRINT "Select an Option.":LOCATE 16,5:PRINT "1. Return to Menu 1       2. Erase Data Files
  404. 4320  LOCATE 14,20:INPUT OPTF$: IF OPTF$<>"1" AND OPTF$<>"2" THEN BEEP: GOTO 4320
  405. 4330  IF OPTF$ ="1" THEN 400
  406. 4400  REDO%=13:  LOCATE 18,1: PRINT "Enter Name of File to be Erased"
  407. 4405  LOCATE 23,5: PRINT"NOTE: Type / to Cancel Erase Option"
  408. 4410  LOCATE 18,38:INPUT GONE$: IF GONE$="/" THEN 400
  409. 4420  FOR K=1 TO LEN(GONE$):IF MID$(GONE$,K,1)="." THEN 4424: ELSE NEXT
  410. 4424  IF MID$(GONE$,2,1)=":" THEN IF K>11 THEN K = 11: GOTO 4440
  411. 4430  IF K>9 THEN K=9
  412. 4440  GONE$=LEFT$(GONE$,K-1): GONER$=GONE$+".BAR": KILL GONER$
  413. 4445   LOCATE 20,5: PRINT " FILE "; GONER$; " ERASED          "
  414. 4447  FOR JMQ1 = 1 TO 1500: NEXT: GOTO 4305
  415. 4450  LOCATE 20,5:PRINT "ERROR: File Name not in List":GOTO 4410
  416. 4490  REM ---------------------------------------------------------------------
  417. 4495  REM                  CLEAR 20 LINES ON SCREEN
  418. 4500  LOCATE 3,1: FOR K2=1 TO 20: PRINT "                    ";:NEXT:RETURN
  419. 4590  REM ---------------------------------------------------------------------
  420. 4595  REM                    READ .bar FILE
  421. 4600  OPEN OLDFILE$ FOR INPUT AS #1
  422. 4610  IF EOF(1) THEN CLOSE: GOTO 4710
  423. 4620  INPUT#1,N,MTH%,YR,YRS,OPT,REF#,YOPT,DUMMY1,DUMMY2
  424. 4630  FOR I=0 TO N: INPUT#1,M#(I):NEXT
  425. 4640  IF OPT<>4 THEN 4660
  426. 4650  FOR I=0 TO N: INPUT#1,S(I),W(I+1):NEXT
  427. 4660  IF EOF(1) THEN 4700
  428. 4670  INPUT#1,TITLE$(1),TITLE$(2),TITLE$(3),QOPT$,R$,DOOP$,GRID$,DUMMY1$,DUMMY2$
  429. 4680  IF OPT<>4 THEN 4700
  430. 4690  FOR I=0 TO N: INPUT#1,LABEL$(I):NEXT
  431. 4700  CLOSE #1
  432. 4705                REM INPUT FROM FILE DATA -- NOW PROCESS IT
  433. 4710  IF OPT=4 THEN GOSUB 5480:  REM DO IT YOURSELF
  434. 4720  IF OPT=1 THEN GOSUB 950:   REM MONTHLY
  435. 4730  IF OPT=2 THEN GOSUB 1210:  REM QUARTERLY
  436. 4740  IF OPT=3 THEN GOSUB 1590:  REM YEARLY
  437. 4750  RETURN 660
  438. 4800  REM --------------------------------------------------------------
  439. 4803  REM             PRINT THE GRAPH
  440. 4805  FOR I=1 TO 25:FOR J=1 TO 80: X=SCREEN (I,J)
  441. 4810  IF I=1 AND J=80 THEN X=160
  442. 4820  IF X<192 THEN 4900
  443. 4830  IF X=218 THEN X=200
  444. 4840  IF X=192 THEN X=170
  445. 4850  IF X=196 THEN X=172
  446. 4860  IF X=197 THEN X=206
  447. 4870  IF X=223 THEN X=175
  448. 4880  IF X=219 THEN X=223
  449. 4890  IF X=249 THEN X=32
  450. 4900  LPRINT CHR$(X);:NEXT:NEXT: IF SAMPLE$="y" THEN RETURN 9010: ELSE RETURN 730:
  451. 5000  REM --------------------------------------------------------------
  452. 5002  REM                DO-IT-YOURSELF
  453. 5003  REDO%=15: CLS : LOCATE 1,22:PRINT MSG$(7)
  454. 5004  IF OPT4=2 THEN GOTO 5510
  455. 5005  LOCATE 5,1:PRINT SEL$:LOCATE 8,22:PRINT "1. Set constant Bar Width and Spacing":LOCATE 10,22:PRINT "2. Enter Widths and Spacing individually"
  456. 5010  LOCATE 5,19
  457. 5020  INPUT DOOP$: IF DOOP$<>"1" AND DOOP$<>"2" THEN BEEP: GOTO 5010
  458. 5030  IF DOOP$="1" THEN LOCATE 13,1:PRINT "Enter the WIDTH (Same for Each Bar)":LOCATE 15,1:PRINT "Enter the SPACE (Between Bars)": ELSE IF OPT4<>2 THEN 5200: ELSE 5130
  459. 5040  LOCATE 13,40:IF OPT4<>2 THEN INPUT Z$: IF VAL(Z$)<1 OR VAL(Z$)>71 THEN BEEP: GOTO 5040: ELSE W=VAL(Z$)\1: GOTO 5060
  460. 5050  PRINT W: GOTO 5060
  461. 5060  LOCATE 15,40:IF OPT4<>2 THEN INPUT Z$:IF VAL(Z$)<0 OR VAL(Z$)\1+W>71 THEN BEEP: GOTO 5060:ELSE S=VAL(Z$)\1: GOTO 5080
  462. 5070  PRINT S: GOTO 5130
  463. 5080  I=1
  464. 5090  I=I+1: IF W*I+S*(I-1)<=71 THEN 5090
  465. 5100  IMAX=I-1
  466. 5110  LOCATE 21,22: PRINT "The Maximum Number of Bars will be";I-1
  467. 5120  LOCATE 23,22: PRINT "To revise Width or Spacing,  press Q."
  468. 5125  LOCATE 1,79: PRINT "*": K$=INKEY$: IF K$="Q" THEN K$ = "q"
  469. 5130  IF K$="q" AND OPT4<>2 THEN LOCATE 22,36:PRINT "    ": LOCATE 1,79: PRINT " ";:GOTO 5040
  470. 5140  IF K$<>" " THEN 5125: ELSE IF OPT4=2 THEN 5510
  471. 5200  PAGE=0: L=0: SV%=L: RE16$="n"
  472. 5210  REDO%=16: CLS:PAGE=PAGE+1: IF RE16$="y" THEN PAGE=PAGE-1
  473. 5220   LOCATE 1,22:PRINT MSG$(7)
  474. 5222  IF OPT4 <>2 THEN LOCATE 21,5: PRINT "NOTE: To signal End of Data, Type / in Label column"
  475. 5225  LOCATE 5,5:PRINT "Label":LOCATE 5,34:PRINT "Value":IF DOOP$="2" THEN LOCATE 5,55:PRINT "Space":LOCATE 5,68:PRINT "Width";
  476. 5230  IF DOOP$="2" AND OPT4<>2 THEN LOCATE 23,1:PRINT "You have used ";:PRINT USING "###";L;:PRINT " of 71 print positions. There are ";:PRINT USING "###";71-L;:PRINT " remaining.";
  477. 5240  IF OPT4=2 THEN RETURN
  478. 5250  IF PAGE>1 THEN 5270
  479. 5260  I=-1
  480. 5270  IF RE16$="y" THEN I=(PAGE-1)*15-1: RE16$="n"
  481. 5280  I=I+1: IF DOOP$="1" AND I=IMAX THEN 5410
  482. 5290  IF L=71 THEN 5410
  483. 5300  IF I=PAGE*15 THEN I=I-1: SV%=L: GOTO 5210
  484. 5310  J=7-(PAGE-1)*15: LOCATE I+J,1:PRINT USING "##";I+1;:PRINT "."
  485. 5320  LOCATE I+J,5:INPUT LABEL$(I):IF LABEL$(I)="/" THEN 5410
  486. 5330  X=LEN(LABEL$(I)):IF X>26 THEN BEEP: GOTO 5320
  487. 5340  LOCATE I+J,34:INPUT Z$: M#(I)=VAL(Z$):IF ABS(M#(I))>1E+15 THEN BEEP:GOTO 5340
  488. 5350  IF DOOP$="1" THEN Y=W: GOTO 5400
  489. 5360  LOCATE I+J,55:INPUT Z$: S(I)=VAL(Z$)\1:IF S(I)>70 OR S(I)<0 THEN BEEP :GOTO 5360: ELSE Y=S(I)
  490. 5370  L=L+Y:IF L>71 THEN L=L-Y: BEEP:GOTO 5360: ELSE GOSUB 5600
  491. 5380  LOCATE I+J,68:INPUT Z$: W(I+1)=VAL(Z$)\1 :IF W(I+1)>71 OR L+W(I+1)>71 THEN BEEP: GOTO 5380: ELSE IF W(I+1)<1 THEN L=L-Y:GOSUB 5600: GOTO 5320
  492. 5390  L=L+W(I+1): GOSUB 5600: Y=W(I+1)
  493. 5400  LABEL$(I)=LEFT$(LABEL$(I),Y): GOTO 5280
  494. 5410  N=I-1: IF N=-1 THEN 400: ELSE GOSUB 5700
  495. 5420  LOCATE 23,1: GOSUB 5900
  496. 5430  IF R$="y" THEN 5470
  497. 5440  IF R$="n" THEN GOSUB 5700 :ELSE BEEP: GOTO 5420
  498. 5450  LOCATE 23,1:PRINT "Enter the Value of the Horizontal Axis.";
  499. 5460  LOCATE 23,50:INPUT Z$: REF#=VAL(Z$) :IF REF#>=1E+16 THEN BEEP: GOTO 5460
  500. 5470  IF DOOP$="2" THEN 5480: ELSE FOR I=1 TO N+1: W(I)=W: S(I)=S:NEXT: S(0)=0: W(0)=0
  501. 5480  XL=0: FOR I=0 TO N+1: XL=XL+S(I)+W(I):NEXT: XL=XL-S(N+1)
  502. 5490  IF OP$="1" OR SAMPLE$="y" THEN RETURN :ELSE RETURN 650
  503. 5500  KEY (1) OFF: IF OPT<>4 THEN 5570: ELSE 5000
  504. 5510  GOSUB 5200: IF PAGE>1 THEN 5530
  505. 5520  I=-1
  506. 5530  I=I+1:IF I<>PAGE*15 THEN 5550
  507. 5540  LOCATE 1,79: PRINT "*": K$=INKEY$: IF K$<>" " THEN 5540: ELSE IF I-1=N THEN 3800: ELSE : GOSUB 5210
  508. 5550  J=7-(PAGE-1)*15:LOCATE I+J,1:PRINT USING "##";I+1;:PRINT ".";:LOCATE I+J,7:PRINT LABEL$(I):LOCATE I+J,36:PRINT M#(I);:IF DOOP$="2" THEN LOCATE I+J,57:PRINT S(I);:LOCATE I+J,70: PRINT W(I+1);
  509. 5560  IF I<N THEN 5530: ELSE I=I+1: GOTO 5540
  510. 5570  ON OPT GOSUB 1000,1190,1540: LOCATE 1,79,0:PRINT "*";
  511. 5580  K$=INKEY$: IF K$<>" " THEN 5580: ELSE 3800
  512. 5600  REM --------------------------------------------------------------
  513. 5610  LOCATE 23,15:PRINT USING "###";L;:LOCATE 23,52:PRINT USING "###";71-L;:RETURN
  514. 5700  REM --------------------------------------------------------------
  515. 5705  REM               CLEAR LINE 22
  516. 5710  LOCATE 22,1: FOR I=1 TO 19: PRINT "        ";:NEXT: RETURN
  517. 5800  REM --------------------------------------------------------------
  518. 5810  IF PRCENT$="n" AND YOPT=3 THEN BEEP: LOCATE 22,1:PRINT "The PERCENTAGE option can be chosen only if all data":PRINT "is non-negative and the total is positive.";
  519. 5820  RETURN
  520. 5900  REM --------------------------------------------------------------
  521. 5903  REM                   RELATIVE TO AVERAGE (Y OR N)
  522. 5905  INPUT "Display the data relative to the average value (Y or N) ";R$: IF R$="Y" THEN R$="y": ELSE IF R$="N" THEN R$="n"
  523. 5910  RETURN
  524. 7000  REM --------------------------------------------------------------
  525. 7003  REM                   ERROR HANDLING
  526. 7005  IF ERR<>71 THEN 7020: ELSE CLS: BEEP:LOCATE 13,25:PRINT "Did you remove the diskette?": LOCATE 1,79: PRINT "*": IF REDO%=10 THEN 7120
  527. 7010  K$=INKEY$: IF K$<>" " THEN 7010: ELSE IF SAMPLE$="y" THEN RESUME 310: ELSE IF REDO%=13 THEN RESUME 4300: ELSE RESUME 400
  528. 7020  IF ERR<>62 THEN 7040: ELSE CLS: BEEP:LOCATE 10,20:PRINT "ERROR: The file you have requested cannot be used."
  529. 7030  LOCATE 1,79:PRINT "*":GOTO 7050
  530. 7040  IF SAMPLE$<>"y" THEN 7060: ELSE CLS: LOCATE 13,20:PRINT "End of Bar Chart SAMPLE Demonstration":LOCATE 1,79:PRINT "*":GOTO 7050
  531. 7050  K$=INKEY$: IF K$<>" " THEN 7050: ELSE RESUME 400
  532. 7060  IF REDO%=1 AND OP$="1" THEN BEEP:GOSUB 5700: LOCATE 18,5: PRINT "ERROR: File ";FILE$;" not in list": RESUME 498
  533. 7070  IF ERR=53 AND REDO%=13 THEN  BEEP:RESUME 4450
  534. 7080  IF OP$="3" AND ERR=64 THEN BEEP:RESUME 4450
  535. 7090  IF ERR<>61 THEN 7100: ELSE CLS:BEEP:LOCATE 10,20:PRINT "The disk appears to be full.":LOCATE 12,20:PRINT "The file you have attempted to save might":LOCATE 14,20:PRINT "not have been completely stored.":LOCATE 1,78:PRINT "*" : GOTO 7120
  536. 7100  IF REDO%=10 AND OPT3=3 THEN LOCATE 23,48: PRINT "This name is invalid.";:BEEP:RESUME 3850
  537. 7110  IF ERR<>27 THEN 7130 ELSE CLS: BEEP:LOCATE 8,20:PRINT "NOTE: Check your printer connection":LOCATE 1,79:PRINT "*"
  538. 7120  K$=INKEY$: IF K$<>" " THEN 7120: ELSE RESUME 3800
  539. 7130  IF REDO%=12 AND ERR=53 THEN BEEP:LOCATE 13,30:PRINT "No files have been stored.": LOCATE 1,79:PRINT "*": ELSE 7150
  540. 7140  K$=INKEY$: IF K$<>" " THEN 7140 ELSE RESUME 400
  541. 7150  IF ERR=24 THEN CLS: LOCATE 13,30:PRINT "Check your printer.": BEEP:LOCATE 1,79:PRINT "*":GOTO 7120
  542. 8000  IF REDO%>8 THEN 8020: ELSE IF REDO%>4 THEN 8010:ELSE IF REDO%=1 THEN RETURN 400: ELSE IF REDO%=2 THEN RETURN 800: ELSE IF REDO%=3 THEN RETURN 900: ELSE IF REDO%=4 THEN RETURN 1000
  543. 8010  IF REDO%=5 THEN RETURN 1100: ELSE IF REDO%=6 THEN RETURN 1190: ELSE IF REDO%=7 THEN RETURN 1500: ELSE IF REDO%=8 THEN  RETURN 1540
  544. 8020  IF REDO%>12 THEN 8030: ELSE IF REDO%=9 THEN RETURN 1700: ELSE IF REDO%=10 THEN RETURN 3800: ELSE IF REDO%=11 THEN RETURN 3900: ELSE IF REDO%=12 THEN RETURN 4300
  545. 8030  IF REDO%=13 THEN RETURN 4400: ELSE IF REDO%=14 THEN RETURN 4100: ELSE IF REDO%=15 THEN RETURN 5000: ELSE IF REDO%=16 THEN RE16$="y": L=SV%: RETURN 5210
  546. 9000  REM --------------------------------------------------------------
  547. 9003  REM                   RUN SAMPLE DATA FILES ("S.BAR")
  548. 9005  KEY (3) OFF: SAMPLE$="y"
  549. 9010  IP = IP +1: Z$="SAMPLE" + ZX$(IP)
  550. 9100  OLDFILE$=Z$+".bar": GOTO 4600
  551.